En esta práctica se elabora un caso práctico orientado a aprender a identificar los datos relevantes para un proyecto analítico y usar las herramientas de integración, limpieza, validación y análisis de los mismos.
● Aprender a aplicar los conocimientos adquiridos y su capacidad de resolución de problemas en entornos nuevos o poco conocidos dentro de contextos más amplios o multidisciplinares.
● Saber identificar los datos relevantes y los tratamientos necesarios (integración, limpieza y validación) para llevar a cabo un proyecto analítico.
● Aprender a analizar los datos adecuadamente para abordar la información contenida en los datos.
● Identificar la mejor representación de los resultados para aportar conclusiones sobre el problema planteado en el proceso analítico.
● Actuar con los principios éticos y legales relacionados con la manipulación de datos en función del ámbito de aplicación.
● Desarrollar las habilidades de aprendizaje que les permitan continuar estudiando de un modo que tendrá que ser en gran medida autodirigido o autónomo.
● Desarrollar la capacidad de búsqueda, gestión y uso de información y recursos en el ámbito de la ciencia de datos.
El conjunto de datos escogido para esta práctica, se titula: “Heart Attack Analysis & Prediction dataset”, el cual tiene como objetivo detectar aquellos factores que pueden actuar como potenciales precursores de las enfermedades cardiovasculares, y así ayudar a la detección y gestión temprana mediante la creación de un modelo. En el conjunto de datos se contemplan un total de 14 características importantes que pueden ayudar a la predicción de desarrollar o no una enfermedad cardíaca. Según la información encontrada, se sabe que las enfermedades cardiovasculares ocupan un porcentaje del 31% en relación a las muertes que se producen en el mundo cada año, por lo que supone una de las causas principales de muerte. Es importane tener en cuenta cuales son los atributos que pueden conllevar a un mayor riesgo cardiovascular o al desarrollo de enfermedad cardiovascular, por lo que, el objetivo es predecir que variables influyen más en este desarrollo.
A continuación, realizamos la descripción de las variables que hay en el dataset “Heart Attack Analysis & Prediction dataset”, usando la información encontrada en la web [Kaggle datasets] (https://www.kaggle.com/datasets), concretamente en el siguiente enlace: https://www.kaggle.com/datasets/rashikrahmanpritom/heart-attack-analysis-predictiondataset
age: Edad del paciente
sex : Sexo del paciente (Sex) (F=0; M=1)
cp : Tipo dolor torácico
++ Value 1 : Angina típica (TA)
++ Value 2 : Angina atípica (ATA)
++ Value 3 : Dolor no-anginal (NAP)
++ Value 4 : Asintomático (ASY)
trtbps : Presión arterial en reposo (in mm Hg)
chol : Colesterol en mg/dl obtenido a través del sensor de IMC
fbs : (Glucemia en ayunas > 120 mg/dl) (1 = true; 0 = false)
restecg : Resultados del electrocardiograma en reposo
++ Value 0 : Normal
++ Value 1 : Presentar anomalías de la onda ST-T (inversión de la onda T y/o elevación o depresión del ST de > 0,05 mV)
++ Value 2 : Hipertrofia ventricular izquierda probable o definida según los criterios de Estes
thalachh : Frecuencia cardiaca máxima alcanzada
exng : Angina inducida por el ejercicio (1 = si; 0 = no)
oldpeak : Pico previo (OldPeak)
slp : Pendiente del segmento ST máximo del ejercicio
caa : Número de grandes buques (0-3)
thall : Tasa de mortalidad
output : 0= menor probabilidad de infarto 1= mayor probabilidad de infarto
Puede ser el resultado de adicionar diferentes datasets o una subselección útil de los datos originales, en base al objetivo que se quiera conseguir.
Primero de todo, cargamos las librerías que vamos a usar durante la práctica
if (!require('dplyr')) install.packages('dplyr');library(dplyr)
## Loading required package: dplyr
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
if (!require('ggplot2')) install.packages('ggplot2');library(ggplot2)
## Loading required package: ggplot2
if (!require('reshape')) install.packages('reshape');library(reshape)
## Loading required package: reshape
##
## Attaching package: 'reshape'
## The following object is masked from 'package:dplyr':
##
## rename
if (!require('plotly')) install.packages('plotly');library(plotly)
## Loading required package: plotly
##
## Attaching package: 'plotly'
## The following object is masked from 'package:reshape':
##
## rename
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
if (!require('plyr')) install.packages('plyr');library(plyr)
## Loading required package: plyr
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:plotly':
##
## arrange, mutate, rename, summarise
## The following objects are masked from 'package:reshape':
##
## rename, round_any
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
if (!require('Stat2Data')) install.packages('Stat2Data');library(Stat2Data)
## Loading required package: Stat2Data
if (!require('corrplot')) install.packages('corrplot');library(corrplot)
## Loading required package: corrplot
## corrplot 0.92 loaded
if (!require('Matrix')) install.packages('matrix');library(Matrix)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following object is masked from 'package:reshape':
##
## expand
if (!require('patchwork')) install.packages('patchwork');library(patchwork)
## Loading required package: patchwork
if (!require('ggcorrplot')) install.packages('ggcorrplot');library(ggcorrplot)
## Loading required package: ggcorrplot
if (!require('C50')) install.packages('ggcorrplot');library(C50)
## Loading required package: C50
if (!require('moments')) install.packages('ggcorrplot');library(moments)
## Loading required package: moments
if (!require('car')) install.packages('ggcorrplot');library(car)
## Loading required package: car
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
if (!require('corrplot')) install.packages('ggcorrplot');library(corrplot)
Cargamos los datos de la base de datos “heart” y tipificamos las variables que tiene el conjunto de datos como corresponde
library(readxl)
heart <- read_excel("~/Documents/AAESTUDIOS/UOC_Máster_Data_Science/4t_Semestre/Tipologia_Ciclodevida_datos/PR2/heart.xlsx")
# Mostramos los primeros registros del conjunto de dtos, con el fin de ver una aproximación de como es el conjunto y su estructura
head(heart, max(10))
## # A tibble: 10 × 14
## age sex cp trtbps chol fbs restecg thalachh exng oldpeak slp
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 63 1 3 145 233 1 0 150 0 2.3 0
## 2 37 1 2 130 250 0 1 187 0 3.5 0
## 3 41 0 1 130 204 0 0 172 0 1.4 2
## 4 56 1 1 120 236 0 1 178 0 0.8 2
## 5 57 0 0 120 354 0 1 163 1 0.6 2
## 6 57 1 0 140 192 0 1 148 0 0.4 1
## 7 56 0 1 140 294 0 0 153 0 1.3 1
## 8 44 1 1 120 263 0 1 173 0 0 2
## 9 52 1 2 172 199 1 1 162 0 0.5 2
## 10 57 1 2 150 168 0 1 174 0 1.6 2
## # ℹ 3 more variables: caa <dbl>, thall <dbl>, output <dbl>
str(heart)
## tibble [303 × 14] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : num [1:303] 1 1 0 1 0 1 0 1 1 1 ...
## $ cp : num [1:303] 3 2 1 1 0 0 1 1 2 2 ...
## $ trtbps : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : num [1:303] 1 0 0 0 0 0 0 0 1 0 ...
## $ restecg : num [1:303] 0 1 0 1 1 1 0 1 1 1 ...
## $ thalachh: num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
## $ exng : num [1:303] 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slp : num [1:303] 0 0 2 2 2 1 1 2 2 2 ...
## $ caa : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
## $ thall : num [1:303] 1 2 2 2 2 1 2 3 3 2 ...
## $ output : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
# Definimos las variables como numericas o categóricas
# Númericas
heart$age<-as.numeric(heart$age)
heart$trtbps<-as.numeric(heart$trtbps)
heart$chol<-as.numeric(heart$chol)
heart$thalachh<-as.numeric(heart$thalachh)
heart$oldpeak<-as.numeric(heart$oldpeak)
heart$caa<-as.numeric(heart$caa)
# Categóricas
heart$sex<-as.factor(heart$sex)
heart$cp<-as.factor(heart$cp)
heart$fbs<-as.factor(heart$fbs)
heart$restecg<-as.factor(heart$restecg)
heart$exng<-as.factor(heart$exng)
heart$slp<-as.factor(heart$slp)
heart$thall<-as.factor(heart$thall)
#Observamos las dimensiones del dataset "heart"
heart.cols<-dim(heart)[2]
heart.rows<-dim(heart)[1]
Podemos ver como el conjunto de datos heart tiene 14 atributos y 303 observaciones
# Creamos una nueva variable 'age_group' basada en la categoria de edad correspondiente
heart$age_group <- cut(heart$age, breaks = c(0, 30, 60, max(heart$age)), labels = c("Joven", "Adulto", "Mayor"))
# Ahora 'age_group' contiene categorías de edad en lugar de valores continuos
str(heart)
## tibble [303 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:303] 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 1 2 1 2 1 2 2 2 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 2 2 1 1 2 2 3 3 ...
## $ trtbps : num [1:303] 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : num [1:303] 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 1 2 2 2 1 2 2 2 ...
## $ thalachh : num [1:303] 150 187 172 178 163 148 153 173 162 174 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 2 1 1 1 1 1 ...
## $ oldpeak : num [1:303] 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 1 3 3 3 2 2 3 3 3 ...
## $ caa : num [1:303] 0 0 0 0 0 0 0 0 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 3 3 3 3 2 3 4 4 3 ...
## $ output : num [1:303] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 2 2 2 2 2 2 ...
# Seleccionamos sólo los pacientes con presión arterial alta, ya que tienen un mayor riesgo
heart <- heart[heart$trtbps > 140, ]
str(heart)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
Ahora vamos a visualizar la información básica del conjunto de datos
# La variable output nos va indicar quien tiene o no una enfermedad del corazón, por lo que primero calculamos el porcentaje de pacientes que tienen enfermedad del corazón y los que no
print("Porcentaje de personas con enfermedad cardiovascular")
## [1] "Porcentaje de personas con enfermedad cardiovascular"
(sum(heart$output == 1)/nrow(heart))*100
## [1] 41.53846
# Vemos que el porcentaje de personas con una enfermedad cardiovascular es del 41,53%
print("Porcentaje de personas sin enfermedad cardiovascular")
## [1] "Porcentaje de personas sin enfermedad cardiovascular"
(sum(heart$output == 0)/nrow(heart))*100
## [1] 58.46154
# Vemos que el porcentaje de personas sin una enfermedad cardiovascular es del 58,46%
# A continuación estudiamos la estadística básica de las variables del conjunto, cargando el sumario de todos los atributos
summary(heart)
## age sex cp trtbps chol fbs restecg
## Min. :40.00 0:22 0:33 Min. :142 Min. :126.0 0:50 0:38
## 1st Qu.:56.00 1:43 1: 5 1st Qu.:150 1st Qu.:225.0 1:15 1:26
## Median :59.00 2:16 Median :152 Median :244.0 2: 1
## Mean :59.25 3:11 Mean :157 Mean :249.9
## 3rd Qu.:65.00 3rd Qu.:160 3rd Qu.:282.0
## Max. :71.00 Max. :200 Max. :407.0
## thalachh exng oldpeak slp caa thall
## Min. : 88.0 0:41 Min. :0.000 0: 8 Min. :0.0000 0: 0
## 1st Qu.:128.0 1:24 1st Qu.:0.200 1:33 1st Qu.:0.0000 1: 7
## Median :147.0 Median :1.000 2:24 Median :0.0000 2:25
## Mean :144.3 Mean :1.392 Mean :0.8308 3:33
## 3rd Qu.:161.0 3rd Qu.:2.300 3rd Qu.:2.0000
## Max. :195.0 Max. :6.200 Max. :3.0000
## output age_group
## Min. :0.0000 Joven : 0
## 1st Qu.:0.0000 Adulto:37
## Median :0.0000 Mayor :28
## Mean :0.4154
## 3rd Qu.:1.0000
## Max. :1.0000
library(ggplot2)
# Edad (age)
summary(heart$age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 40.00 56.00 59.00 59.25 65.00 71.00
g1<-ggplot(data=heart, aes(x=age))+
geom_density(color="darkblue", fill="blue") +
labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1
# Sexo (sex)
summary(heart$sex)
## 0 1
## 22 43
g2<-ggplot(data=heart, aes(x=sex))+
geom_bar(mapping = aes(x=sex, fill=sex)) +
labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento")
g2
# Dolor Torácico (cp)
summary(heart$cp)
## 0 1 2 3
## 33 5 16 11
g3<-ggplot(data=heart, aes(x=cp))+
geom_bar(aes(fill=cp)) +
facet_grid(~sex) +
labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento")
g3
# Presión Arterial en Reposo (trtbps)
summary(heart$trtbps)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 142 150 152 157 160 200
g4<-ggplot(data=heart, aes(x=trtbps))+
geom_histogram(color="darkblue", fill="green") +
facet_grid(~sex) +
labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento")
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Colesterol Sérico
summary(heart$chol)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 126.0 225.0 244.0 249.9 282.0 407.0
g5<-ggplot(data=heart, aes(x=chol))+
geom_histogram(color="darkblue", fill="yellow") +
facet_grid(~sex) +
labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Glucemia en ayunas (fbs)
summary(heart$fbs)
## 0 1
## 50 15
g6<-ggplot(data=heart, aes(x=fbs))+
geom_bar(fill="maroon4") +
facet_grid(~sex) +
labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento")
g6
# Electrocardiograma en Reposo (restecg)
summary(heart$restecg)
## 0 1 2
## 38 26 1
g7<-ggplot(data=heart, aes(x=restecg))+
geom_bar(aes(fill=restecg)) +
facet_grid(~sex) +
labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento")
g7
# Frecuencia Cardíaca Máxima (thalachh)
summary(heart$thalachh)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 88.0 128.0 147.0 144.3 161.0 195.0
g8<-ggplot(data=heart, aes(x=thalachh))+
geom_density(color="darkblue", fill="brown") +
facet_grid(~sex) +
labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8
# Angina de Esfuerzo (exng)
summary(heart$exng)
## 0 1
## 41 24
g9<-ggplot(data=heart, aes(x=exng))+
geom_bar(aes(fill=exng)) +
facet_grid(~sex) +
labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento")
g9
# Antiguo pico (oldpeak)
summary(heart$oldpeak)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.200 1.000 1.392 2.300 6.200
g10<-ggplot(data=heart, aes(x=oldpeak))+
geom_histogram(color="black", fill="turquoise") +
facet_grid(~sex) +
labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Pendiente del Segmento ST máximo (slp)
summary(heart$slp)
## 0 1 2
## 8 33 24
g11<-ggplot(data=heart, aes(x=slp))+
geom_bar(aes(fill=slp))+
facet_grid(~sex) +
labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento")
g11
# Número de grandes buques (caa)
summary(heart$caa)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.8308 2.0000 3.0000
g12<-ggplot(data=heart, aes(x=caa))+
geom_bar(fill="forestgreen")+
facet_grid(~sex) +
labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento")
g12
# Tasa de Mortalidad (thall)
summary(heart$thall)
## 0 1 2 3
## 0 7 25 33
g13<-ggplot(data=heart, aes(x=thall))+
geom_bar(aes(fill=thall))+
facet_grid(~sex) +
labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento")
g13
# Variable Cardiopatía (output)
summary(heart$output)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.4154 1.0000 1.0000
g14<-ggplot(data=heart, aes(x=output))+
geom_bar(fill="purple")+
facet_grid(~sex) +
labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento")
g14
# Grupo de edad (age_group)
summary(heart$age_group)
## Joven Adulto Mayor
## 0 37 28
g15<-ggplot(data=heart, aes(x=age_group))+
geom_bar(aes(fill=age_group))+
facet_grid(~sex) +
labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento")
g15
#Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables numéricas
library(ggcorrplot)
df2 <- heart[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart
# Hacemos cópia de los datos antes de iniciar la limpieza
heart_ld<-heart
# Primero determinamos el número de valores vacíos o valores en blanco
colSums(is.na(heart_ld))
## age sex cp trtbps chol fbs restecg thalachh
## 0 0 0 0 0 0 0 0
## exng oldpeak slp caa thall output age_group
## 0 0 0 0 0 0 0
colSums(heart_ld=="")
## age sex cp trtbps chol fbs restecg thalachh
## 0 0 0 0 0 0 0 0
## exng oldpeak slp caa thall output age_group
## 0 0 0 0 0 0 0
# Vemos como no hay ningun valor nulo en el conjunto de datos
# Estudiamos si hay valores que estén duplicados
sum(duplicated(heart_ld)) # Hay una fila que está repetida
## [1] 0
# Buscamos cual es la fila repetida
duplicated_rows <- duplicated(heart_ld)
duplicate_row <- heart_ld[duplicated_rows, ]
heart_ld <- unique(heart_ld) # Eliminamos la filas duplicada
sum(duplicated(heart_ld)) # Comprobamos como ahora no hay ninguna fila duplicada
## [1] 0
Seguidamente es importante estudiar la posibilidad de valores outliers para las variables númericas de la base de datos
# Para ello, creamos una función para que la podamos aplicar en cada uno de los atributos, de la cual obtengamos un gráfico Boxplot y una representación de puntos en forma de vector para poder visualizar mejor la posibilidad de valores outliers.
analisis_outliers <- function(variable, name){
# Creamos el gráfico
fig <- plot_ly(type = 'box')
# Representamos la variable
fig <- fig %>% add_boxplot(y = variable,
jitter = 0.3,
pointpos = -1.8,
boxpoints = 'all',
marker = list(color = 'rgb(47,79,79)'),
line = list(color = 'rgb(220,20,60)'),
fillcolor= list(color='rgb(220,20,60)'),
name = name)
fig <- fig %>% layout(title = paste("Análisis de valores Outliers de la variable", name))
# Obtenemos los posibles outliers
outliers <- boxplot.stats(variable)$out
return(list(outliers=outliers, fig=fig))
}
# Age
# Obtenemos la lista resultante de la función de análisis de outliers.
analisis = analisis_outliers(heart_ld$age,"Age")
# Representamos los datos con un gráfico BoxPlot
analisis$fig # No hay valores outliers
# Resting Blood Pressure (trtbps)
analisis = analisis_outliers(heart_ld$trtbps,"Resting Blood Pressure")
analisis$fig # Tampoco encontramos valores outliers, ya que, al filtrar con valores > 140, entendemos que todos los valores son posibles
# Cholesterol (chol)
analisis = analisis_outliers(heart_ld$chol,"Cholesterol")
analisis$fig
# Vemos que la distribución está centrada entre 126 y 400, por lo que no vemos ningún punto outlier.
# Maximum Heart Rate (thalachh)
analisis = analisis_outliers(heart_ld$thalachh,"Maximum Heart Rate")
analisis$fig #No se observan valores outliers
# Oldpeak (oldpeak)
analisis = analisis_outliers(heart_ld$oldpeak,"Oldpeak")
analisis$fig #Hay puntos que podrían ser valores outliers
# Visualizamos los valores candidatos a outliers
analisis$outliers
## [1] 6.2
# Vemos como es posible que se den estos valores, por lo que no hacemos ninguna acción en la variable
# Mostramos el resumen de los datos después de haber limpiado todo el conjunto
str(heart_ld)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 2 1 2 1 ...
## $ cp : Factor w/ 4 levels "0","1","2","3": 4 3 3 4 4 1 3 2 3 3 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 2 1 2 1 1 2 1 2 1 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 1 2 2 1 2 2 2 2 2 1 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 1 2 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : Factor w/ 3 levels "0","1","2": 1 3 3 3 1 3 2 3 3 1 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : Factor w/ 4 levels "0","1","2","3": 2 4 3 3 3 3 3 3 3 3 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
# Vemos como ahora tenemos 15 atributos y hemos cambiado a tener 65 observaciones
summary(heart_ld)
## age sex cp trtbps chol fbs restecg
## Min. :40.00 0:22 0:33 Min. :142 Min. :126.0 0:50 0:38
## 1st Qu.:56.00 1:43 1: 5 1st Qu.:150 1st Qu.:225.0 1:15 1:26
## Median :59.00 2:16 Median :152 Median :244.0 2: 1
## Mean :59.25 3:11 Mean :157 Mean :249.9
## 3rd Qu.:65.00 3rd Qu.:160 3rd Qu.:282.0
## Max. :71.00 Max. :200 Max. :407.0
## thalachh exng oldpeak slp caa thall
## Min. : 88.0 0:41 Min. :0.000 0: 8 Min. :0.0000 0: 0
## 1st Qu.:128.0 1:24 1st Qu.:0.200 1:33 1st Qu.:0.0000 1: 7
## Median :147.0 Median :1.000 2:24 Median :0.0000 2:25
## Mean :144.3 Mean :1.392 Mean :0.8308 3:33
## 3rd Qu.:161.0 3rd Qu.:2.300 3rd Qu.:2.0000
## Max. :195.0 Max. :6.200 Max. :3.0000
## output age_group
## Min. :0.0000 Joven : 0
## 1st Qu.:0.0000 Adulto:37
## Median :0.0000 Mayor :28
## Mean :0.4154
## 3rd Qu.:1.0000
## Max. :1.0000
#Volvemos a visualizar los datos en conjunto como al inicio, pero con los datos limpios
#Edad
summary(heart_ld$age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 40.00 56.00 59.00 59.25 65.00 71.00
g1<-ggplot(data=heart_ld, aes(x=age))+
geom_density(color="darkblue", fill="blue") +
labs(title = "Edad de los pacientes", x="Edad", y= "Densidad")
g1
#Sexo
summary(heart_ld$sex)
## 0 1
## 22 43
g2<-ggplot(data=heart_ld, aes(x=sex))+
geom_bar(mapping = aes(x=sex, fill=sex)) +
labs(title = "Sexo de los pacientes", x="Sexo", y= "Recuento")
g2
#Dolor Torácico (cp)
summary(heart_ld$cp)
## 0 1 2 3
## 33 5 16 11
g3<-ggplot(data=heart_ld, aes(x=cp))+
geom_bar(aes(fill=cp)) +
facet_grid(~sex) +
labs(title = "Distribución del Dolor Torácico", x="Dolor Torácico", y= "Recuento") + theme_classic()
g3
#Presión Arterial en Reposo (trtbps)
summary(heart_ld$trtbps)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 142 150 152 157 160 200
g4<-ggplot(data=heart_ld, aes(x=trtbps))+
geom_histogram(color="darkblue", fill="green") +
facet_grid(~sex) +
labs(title = "Distribución de la Presión Arterial en Reposo", x="Presión Arterial en Reposo (mm Hg)", y= "Recuento")
g4
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Colesterol Sérico (chol)
summary(heart_ld$chol)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 126.0 225.0 244.0 249.9 282.0 407.0
g5<-ggplot(data=heart_ld, aes(x=chol))+
geom_histogram(color="darkblue", fill="yellow") +
facet_grid(~sex) +
labs(title = "Distribución del Colesterol Sérico", x="Colesterol Sérico (mm/dl)", y= "Recuento")
g5
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Glucemia en ayunas (fbs)
summary(heart_ld$fbs)
## 0 1
## 50 15
g6<-ggplot(data=heart_ld, aes(x=fbs))+
geom_bar(fill="maroon4") +
facet_grid(~sex) +
labs(title = "Distribución Glucemia en ayunas > 120", x="Glucemia en Ayunas", y= "Recuento")
g6
# Electrocardiograma en Reposo (restecg)
summary(heart_ld$restecg)
## 0 1 2
## 38 26 1
g7<-ggplot(data=heart_ld, aes(x=restecg))+
geom_bar(aes(fill=restecg)) +
facet_grid(~sex) +
labs(title = "Distribución ECG en Reposo", x="ECG en Reposo", y= "Recuento")
g7
#Frecuencia Cardíaca Máxima (thalachh)
summary(heart_ld$thalachh)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 88.0 128.0 147.0 144.3 161.0 195.0
g8<-ggplot(data=heart_ld, aes(x=thalachh))+
geom_density(color="darkblue", fill="brown") +
facet_grid(~sex) +
labs(title = "Distribución Frecuencia Cardíaca Máxima alcanzada", x="Frecuencia Cardíaca Máxima", y= "Densidad")
g8
#Angina de Esfuerzo (exng)
summary(heart_ld$exng)
## 0 1
## 41 24
g9<-ggplot(data=heart_ld, aes(x=exng))+
geom_bar(aes(fill=exng)) +
facet_grid(~sex) +
labs(title = "Distribución Anginas Inducidas por Esfuerzo", x="Angina Inducida por Esfuerzo", y= "Recuento")
g9
#Antiguo pico (oldpeak)
summary(heart_ld$oldpeak)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.200 1.000 1.392 2.300 6.200
g10<-ggplot(data=heart_ld, aes(x=oldpeak))+
geom_histogram(color="black", fill="turquoise") +
facet_grid(~sex) +
labs(title = "Distribución Valor Medido en Depresión", x="Valor", y= "Recuento")
g10
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Pendiente del Segmento ST máximo (slp)
summary(heart_ld$slp)
## 0 1 2
## 8 33 24
g11<-ggplot(data=heart_ld, aes(x=slp))+
geom_bar(aes(fill=slp))+
facet_grid(~sex) +
labs(title = "Distribución Pendiente ST", x="Pendiente ST", y= "Recuento")
g11
# Número de grandes buques (caa)
summary(heart_ld$caa)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.8308 2.0000 3.0000
g12<-ggplot(data=heart_ld, aes(x=caa))+
geom_bar(fill="forestgreen")+
facet_grid(~sex) +
labs(title = "Distribución del Número de Buques", x="Nº de buques", y= "Recuento")
g12
# Tasa de Mortalidad (thall)
summary(heart_ld$thall)
## 0 1 2 3
## 0 7 25 33
g13<-ggplot(data=heart_ld, aes(x=thall))+
geom_bar(aes(fill=thall))+
facet_grid(~sex) +
labs(title = "Distribución de la Tasa de Mortalidad", x="Tasa de mortalidad", y= "Recuento")
g13
#Variable Cardiopatía (output)
summary(heart_ld$output)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.4154 1.0000 1.0000
g14<-ggplot(data=heart_ld, aes(x=output))+
geom_bar(fill="purple")+
facet_grid(~sex) +
labs(title = "Distribución Cardiopatía (Y/N)", x="Cardiopatía", y= "Recuento")
g14
# Grupo de edad (age_group)
summary(heart_ld$age_group)
## Joven Adulto Mayor
## 0 37 28
g15<-ggplot(data=heart_ld, aes(x=age_group))+
geom_bar(aes(fill=age_group))+
facet_grid(~sex) +
labs(title = "Distribución de los grupos de edad", x="Grupo de edad", y= "Recuento")
g15
#Visualizamos los resultados en una matriz de correlaciones, incluyendo todas las variables
library(ggcorrplot)
df2 <- heart_ld[c(14, 1,4,5, 8, 10, 12)]
corr <- cor(round(df2, 2))
corr_chart<-ggcorrplot(corr ,hc.order=TRUE,lab=FALSE)
corr_chart
# De la misma manera que en la limpieza de los datos, creamos una cópia para trabajar la discretización de las variables
heart_discr<-heart_ld
# A continuación iniciamos el proceso de discretización de las variables para poder realizar correctamente los análisis posteriormente
# Age
heart_discr["age"] <- cut(heart_discr$age, breaks=c(-Inf, 40,65,+Inf),
labels=c("Adulto","Mediana edad","Tercera edad"))
# Comprobamos como quedan los datos
summary(heart_discr$age)
## Adulto Mediana edad Tercera edad
## 1 49 15
#Resting Blood Pressure
heart_discr["trtbps"] <- cut(heart_discr$trtbps, breaks=c(-Inf, 120, 140,+Inf),
labels=c("Normal","Alta","Muy Alta"))
# Comprobamos como quedan los datos
summary(heart_discr$trtbps)
## Normal Alta Muy Alta
## 0 0 65
# Cholesterol
heart_discr["chol"] <- cut(heart_discr$chol, breaks=c(-Inf, 200, 240,+Inf),
labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$chol)
## Normal Alto Muy Alto
## 9 20 36
# Maximum Rate Freq
heart_discr["thalachh"] <- cut(heart_discr$thalachh, breaks=c(-Inf, 120, 160,+Inf),
labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$thalachh)
## Normal Alto Muy Alto
## 12 36 17
# Oldpeak
heart_discr["oldpeak"] <- cut(heart_discr$oldpeak, breaks=c(-Inf, 2, 2.55, +Inf),
labels=c("Normal","Alto","Muy Alto"))
# Comprobamos como quedan los datos
summary(heart_discr$oldpeak)
## Normal Alto Muy Alto
## 48 2 15
(p.ej., si se van a comparar grupos de datos, ¿cuáles son estos grupos y qué tipo de análisis se van a aplicar?)
Para analizar y comparar los datos seleccionados, dividiremos el enfoque en tres partes, centrándonos en la predicción de ataques cardíacos (variable “output”) en relación con las variables de interés. Dividiremos el análisis en tres partes sobre las variables que anteriormente hemos seleccionado. El objetivo y la respuesta a contestar es el tratar de aclarar que tipo de condiciones ayudan a predecir con mejor medida un ataque al corazón.
Los análisis que realizaremos son los siguientes
ANOVA (Análisis Comparativo): Evaluaremos la diferencia en la variable de salida (“output”) en función de la edad, presión arterial, nivel de colesterol, frecuencia cardíaca máxima alcanzada, depresión inducida por el ejercicio y el número de grandes vasos. Esto nos permite determinar si hay diferencias significativas en la media de “output” entre los distintos niveles de estas variables.
Matriz de Correlaciones: Exploraremos las relaciones lineales entre todas las variables seleccionadas. Este análisis nos mostrará cómo se correlacionan entre sí las variables, permitiendo identificar asociaciones y patrones de relación, lo que podría sugerir qué variables están más estrechamente relacionadas con la presencia de ataques cardíacos.
Modelo Predictivo (Regresión Logística): Utilizaremos una regresión logística para predecir la ocurrencia de ataques cardíacos (“output”) basándonos en las variables con una correlación relevante en la matriz anterior. Analizaremos variables como el tipo de dolor torácico, frecuencia cardíaca máxima alcanzada, tasa de mortalidad, angina inducida por el ejercicio, pendiente del segmento ST máximo del ejercicio y el número de grandes buques. El objetivo es comprender qué variables son predictivas de ataques cardíacos y en qué medida influyen en la predicción.
Estos análisis proporcionarán una visión detallada sobre cómo las diferentes variables están relacionadas con la presencia de ataques cardíacos y qué factores pueden ser más relevantes para predecirlos.
Para evaluar la normalidad de las variables seleccionadas, empleamos la prueba de Spahiro-Wilk
# Una vez tenemos los datos discretizados, comprobamos la normalidad
# Usamos la prueba de Shapiro-Wilk para verificar la normalidad de cada variable numérica
variables <- c("age", "trtbps", "chol", "thalachh", "oldpeak")
resultados_shapiro <- lapply(heart_ld[variables], shapiro.test)
names(resultados_shapiro) <- variables
# Verificar la estructura de las variables seleccionadas en el conjunto de datos 'heart'
str(heart_ld[, variables])
## tibble [65 × 5] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ thalachh: num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
# Mostramos los resultados
print(resultados_shapiro)
## $age
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.95453, p-value = 0.01792
##
##
## $trtbps
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.86409, p-value = 3.916e-06
##
##
## $chol
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.98135, p-value = 0.4328
##
##
## $thalachh
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.97832, p-value = 0.3102
##
##
## $oldpeak
##
## Shapiro-Wilk normality test
##
## data: X[[i]]
## W = 0.88182, p-value = 1.542e-05
Los resultados de la normalidad muestran que para la variable ‘age’ (edad) hay evidencia suficiente para rechazar la hipótesis nula y afirmar que los datos no siguen una distribución normal, igual que la variable ‘trtbps’ (presión arterial en reposo) y la variable ‘oldpeak’, donde la evidencia para rechazar la hipótesis de normalidad es más fuerte.
Por otro lado, ni la variable ‘chol’ (colesterol) ni la variable ‘thalachh’ (ritmo cardíaco máximo aclanzada) muestran suficiente evidencia para rechazar la hipótesis nula de normalidad, sugiriendo que los datos de ambas variables podrían seguir una distribución normal.
Calculamos las varianzas de las variables numéricas agrupadas por categorías de edad. Esto nos va a proporcionar una visión de como varían ‘age’, ‘trtbps’, ‘chol’, ‘thalachh’, y ‘oldpeak’ en distintos grupos de edad en el riesgo de sufrir un ataque cardíaco.
# A continuación comprobamos la varianza, en función del grupo de edad al que pertenece
# Calculamos las varianzas de las variables numéricas por grupos de edad
varianzas_por_edad <- aggregate(cbind(age, trtbps, chol, thalachh, oldpeak) ~ age_group, data = heart_ld, FUN = var)
print(varianzas_por_edad)
## age_group age trtbps chol thalachh oldpeak
## 1 Adulto 30.863363 195.8363 2083.790 695.5465 1.578078
## 2 Mayor 8.469577 109.8029 2852.787 291.9894 2.138029
Clasificamos la varible ‘output’ en dos categorías (‘Yes’ y ’No) para investigar las varianzas de las variables numéricas respecto a la probabilidad de sufrir un ataque cardíaco
# Calculamos las varianzas de las variables numéricas según si tiene riesgo de ataque al corazón o no
# Antes de nada clasificamos la variable 'output' en dos categorías ("Yes" y "No")
heart_var<-heart_ld
heart_var$output <- factor(heart_var$output, levels = c(0, 1), labels = c("No", "Yes"))
# Comprobamos como quedan los datos
summary(heart_var$output)
## No Yes
## 38 27
varianzas_por_output <- aggregate(cbind(age, trtbps, chol, thalachh, oldpeak) ~ output, data = heart_var, FUN = var)
print(varianzas_por_output)
## output age trtbps chol thalachh oldpeak
## 1 No 46.13656 196.8798 2394.200 542.7994 2.216508
## 2 Yes 62.39601 100.1795 2385.538 308.9088 1.002080
Los resultados resaltan las diferencias en las varianzas de estas variables entre aquellos casos con mayor probabilidad de sufrir un ataque cardíaco y los que no.
Esta evaluación proporciona una visión detallada de cómo las variables numéricas varían en relación con la edad y la probabilidad de sufrir un ataque cardíaco, lo que puede ser fundamental para comprender los factores de riesgo asociados
Para realizar un análisis comparativo de todas las variables numéricas y la variable output, empleamos la prueba estadística de ANOVA, prueba que evalúa si hay diferencias significativas en la media de la variable de salida entre los distintos niveles de las variables numéricas.
# ANOVA entre la variable de salida (output) y las variables numéricas
anova_output_age <- aov(output ~ age, data = heart_ld)
anova_output_trtbps <- aov(output ~ trtbps, data = heart_ld)
anova_output_chol <- aov(output ~ chol, data = heart_ld)
anova_output_thalachh <- aov(output ~ thalachh, data = heart_ld)
anova_output_oldpeak <- aov(output ~ oldpeak, data = heart_ld)
anova_output_caa <- aov(output ~ caa, data = heart_ld)
# Resumen de los resultados del ANOVA
summary(anova_output_age)
## Df Sum Sq Mean Sq F value Pr(>F)
## age 1 0.003 0.00338 0.013 0.908
## Residuals 63 15.781 0.25050
summary(anova_output_trtbps)
## Df Sum Sq Mean Sq F value Pr(>F)
## trtbps 1 0.259 0.2587 1.05 0.309
## Residuals 63 15.526 0.2464
summary(anova_output_chol)
## Df Sum Sq Mean Sq F value Pr(>F)
## chol 1 0.206 0.2055 0.831 0.365
## Residuals 63 15.579 0.2473
summary(anova_output_thalachh)
## Df Sum Sq Mean Sq F value Pr(>F)
## thalachh 1 2.386 2.3858 11.22 0.00137 **
## Residuals 63 13.399 0.2127
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_oldpeak)
## Df Sum Sq Mean Sq F value Pr(>F)
## oldpeak 1 0.906 0.9061 3.837 0.0546 .
## Residuals 63 14.878 0.2362
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(anova_output_caa)
## Df Sum Sq Mean Sq F value Pr(>F)
## caa 1 2.536 2.5357 12.06 0.000938 ***
## Residuals 63 13.249 0.2103
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Teniendo en cuenta los resultados, parece que la frecuencia cardíaca máxima alcanzada (thalachh), el número de grandes vasos (caa) y, en menor medida, la depresión inducida por el ejercicio (oldpeak) tienen asociaciones significativas con la presencia de enfermedades cardíacas. Sin embargo, la edad (age), la presión arterial en reposo (trtbps) y el nivel de colesterol (chol) en sangre no parecen estar asociados de manera significativa con la variable de salida (output) en este análisis.
Mediante la creación de una matriz de correlaciones, procederemos a estudiar la relación que hay entre cada uno de los atributos del conjunto de datos, mediante los datos limpios sin la discretización (heart_ld) y convertimos aquellas variables categóricas en númericas
# Creamos una cópia de los datos limpios sin discretizar para convertirlos todos en numéricos, y teniendo en cuenta la información aportada en la descripción de las variables
heart_cor <-heart_ld
# sex
heart_cor$sex <- as.numeric(as.character(heart_cor$sex))
# cp
heart_cor$cp <- as.numeric(as.character(heart_cor$cp))
# fbs
heart_cor$fbs <- as.numeric(as.character(heart_cor$fbs))
# restecg
heart_cor$restecg <- as.numeric(as.character(heart_cor$restecg))
# exng
heart_cor$exng <- as.numeric(as.character(heart_cor$exng))
# slp
heart_cor$slp <- as.numeric(as.character(heart_cor$slp))
# thall
heart_cor$thall <- as.numeric(as.character(heart_cor$thall))
# output
heart_cor$output <- as.numeric(as.character(heart_cor$output))
heart_cor$output
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0
## [39] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# Imprimimos la estructura de este nuevo dataset para ver como han sido transformadas las variables
str(heart_cor)
## tibble [65 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:65] 63 52 57 58 66 43 61 71 59 46 ...
## $ sex : num [1:65] 1 1 1 0 0 1 1 0 1 0 ...
## $ cp : num [1:65] 3 2 2 3 3 0 2 1 2 2 ...
## $ trtbps : num [1:65] 145 172 150 150 150 150 150 160 150 142 ...
## $ chol : num [1:65] 233 199 168 283 226 247 243 302 212 177 ...
## $ fbs : num [1:65] 1 1 0 1 0 0 1 0 1 0 ...
## $ restecg : num [1:65] 0 1 1 0 1 1 1 1 1 0 ...
## $ thalachh : num [1:65] 150 162 174 162 114 171 137 162 157 160 ...
## $ exng : num [1:65] 0 0 0 0 0 0 1 0 0 1 ...
## $ oldpeak : num [1:65] 2.3 0.5 1.6 1 2.6 1.5 1 0.4 1.6 1.4 ...
## $ slp : num [1:65] 0 2 2 2 0 2 1 2 2 0 ...
## $ caa : num [1:65] 0 0 0 0 0 0 0 2 0 0 ...
## $ thall : num [1:65] 1 3 2 2 2 2 2 2 2 2 ...
## $ output : num [1:65] 1 1 1 1 1 1 1 1 1 1 ...
## $ age_group: Factor w/ 3 levels "Joven","Adulto",..: 3 2 2 2 3 2 3 3 2 2 ...
# Vemos que ahora todos los atributos son numéricos, por lo que podemos crear la matriz de correlaciones.
# Hacemos el cálculo de la matriz
# Primero quitamos la variable del grupo de edad
heart_cor <- heart_cor[, -15]
corr <- round(cor(heart_cor), 1)
# Realizamos la representación gráfic con los resultados
col <- colorRampPalette(c("#0000CD", "#7D26CD", "#FFFFFF",
"#FF6347","#FF0000"))
corrplot(corr, method = "square", shade.col = NA, tl.col = "black",
tl.srt = 45, col = col(200), addCoef.col = "black", order = "AOE",
type = "upper", diag = F, addshade = "all")
Viendo la matriz de correlaciones y las complementarias gráficas que
hemos ido viendo a lo largo del análisis, podemos confirmar que existe
una clara relación entre las variables incluidas en el conjunto de datos
y el hecho de padecer una enfermedad cardiovascular. De la misma manera,
vemos cuales son las diferentes relaciones entre las variables y la
manera en que podemos reducir el riesgo de padecder la enfermedad, hecho
que podemos estudiar con el método de componentes principales (PCA) y a
continuación.
# Mostramos la matriz de correlaciones que nos indica las relaciones entre las diferentes variables.
round(cor(heart_cor),2)
## age sex cp trtbps chol fbs restecg thalachh exng oldpeak
## age 1.00 -0.21 0.06 0.12 0.09 0.07 0.01 -0.25 0.00 0.06
## sex -0.21 1.00 0.05 -0.15 -0.24 0.08 -0.16 -0.16 -0.06 -0.11
## cp 0.06 0.05 1.00 -0.01 -0.07 0.18 0.02 0.36 -0.45 -0.18
## trtbps 0.12 -0.15 -0.01 1.00 0.27 0.22 0.01 0.07 0.16 0.10
## chol 0.09 -0.24 -0.07 0.27 1.00 -0.19 -0.16 -0.02 0.21 0.02
## fbs 0.07 0.08 0.18 0.22 -0.19 1.00 0.04 0.06 -0.04 0.05
## restecg 0.01 -0.16 0.02 0.01 -0.16 0.04 1.00 0.09 0.04 -0.04
## thalachh -0.25 -0.16 0.36 0.07 -0.02 0.06 0.09 1.00 -0.38 -0.20
## exng 0.00 -0.06 -0.45 0.16 0.21 -0.04 0.04 -0.38 1.00 0.04
## oldpeak 0.06 -0.11 -0.18 0.10 0.02 0.05 -0.04 -0.20 0.04 1.00
## slp -0.14 0.07 0.11 -0.10 0.01 -0.09 0.18 0.39 -0.34 -0.60
## caa 0.14 -0.12 -0.40 0.02 0.08 0.09 -0.20 -0.19 0.03 0.17
## thall -0.14 0.13 -0.13 0.07 0.09 -0.05 -0.05 0.09 0.07 0.14
## output 0.01 -0.12 0.63 -0.13 -0.11 0.13 0.14 0.39 -0.39 -0.24
## slp caa thall output
## age -0.14 0.14 -0.14 0.01
## sex 0.07 -0.12 0.13 -0.12
## cp 0.11 -0.40 -0.13 0.63
## trtbps -0.10 0.02 0.07 -0.13
## chol 0.01 0.08 0.09 -0.11
## fbs -0.09 0.09 -0.05 0.13
## restecg 0.18 -0.20 -0.05 0.14
## thalachh 0.39 -0.19 0.09 0.39
## exng -0.34 0.03 0.07 -0.39
## oldpeak -0.60 0.17 0.14 -0.24
## slp 1.00 -0.19 -0.12 0.35
## caa -0.19 1.00 0.01 -0.40
## thall -0.12 0.01 1.00 -0.27
## output 0.35 -0.40 -0.27 1.00
Nos fijamos en la variable que realmente nos interesa para saber que factores ayudan a predecir que se de un ataque al corazón, que es el output. Esta variable presenta una mayor correlación con ‘cp’ (tipo de dolor torácico), ‘thalachh’ (frecuencia cardíaca máxima alcanzada), ‘thall’ (tasa de mortalidad), ‘exng’ (angina inducida por el ejercicio), ‘slp’ (pendiente del segmento ST máximo del ejercicio) y ‘caa’ (número de grandes buques). Por tanto, estas serán las variables que analizaremos.
Para construir un modelo predictivo usando regresión logística con las variables seleccionadas, usamos la función glm().
# Ajustamos un modelo de regresión logística para predecir enfermedades cardíacas
model <- glm(output ~ cp + thalachh + thall + exng + slp + caa, data = heart_cor, family = "binomial")
summary(model)
##
## Call:
## glm(formula = output ~ cp + thalachh + thall + exng + slp + caa,
## family = "binomial", data = heart_cor)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.71804 3.43486 -0.791 0.42876
## cp 1.39069 0.49801 2.792 0.00523 **
## thalachh 0.02077 0.02308 0.900 0.36811
## thall -1.62525 0.72573 -2.239 0.02512 *
## exng 0.21629 1.08349 0.200 0.84177
## slp 1.44980 0.80859 1.793 0.07297 .
## caa -1.06408 0.58490 -1.819 0.06887 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 88.239 on 64 degrees of freedom
## Residual deviance: 42.656 on 58 degrees of freedom
## AIC: 56.656
##
## Number of Fisher Scoring iterations: 6
# Predicciones usando el modelo
predictions <- predict(model, type = "response")
El modelo de regresión logística creado, intenta predecir la probabilidad de ocurrencia de enfermedades cardíacas (output) basándose en las variables predictoras (cp, thalachh, thall, exng, slp y caa).
En resumen, las variables cp (Tipo de dolor torácico) y thall (Frecuencia cardíaca máxima alcanzada) parecen ser las más influyentes para predecir la ocurrencia de enfermedades cardíacas en este modelo, mientras que otras variables como thalachh, exng, slp y caa muestran asociaciones que podrían ser significativas a diferentes niveles de confianza o podrían necesitar más datos para una conclusión más sólida.
El AIC del modelo es 56.656, lo que sugiere que este modelo podría mejorar con ajustes adicionales o la inclusión de más variables predictoras.
La deviance residual es significativamente menor que la deviance nula, lo que sugiere que el modelo con las variables predictoras tiene un mejor ajuste que un modelo sin estas variables, lo que indica que las variables incluidas en el modelo explican parte de la variabilidad en la variable de salida (enfermedades cardíacas).
Los resultados obtenidos son esenciales para entender las posibles relaciones entre las variables estudiadas y la presencia de enfermedades cardíacas.
Se identificaron algunas variables con asociaciones más fuertes con la presencia de enfermedades cardíacas, como el tipo de dolor torácico (‘cp’), la frecuencia cardíaca máxima alcanzada (‘thalachh’), y el número de grandes vasos (‘caa’). Estas variables podrían considerarse como importantes indicadores o factores de riesgo para las enfermedades cardíacas.
En contraste, otras variables como la edad (‘age’), la presión arterial en reposo (‘trtbps’), y el nivel de colesterol en sangre (‘chol’) no mostraron asociaciones significativas con la presencia de enfermedades cardíacas en este análisis.
Algunas variables, como la frecuencia cardíaca máxima (‘thalachh’), aunque no mostraron asociación significativa en el modelo de regresión logística, tienen fuertes correlaciones con la presencia de enfermedades cardíacas según la matriz de correlaciones. Esto sugiere que podrían tener alguna influencia que quizás no se ha capturado completamente en el modelo actual. En cuanto a responder al problema, estos resultados proporcionan una comprensión inicial de qué variables pueden estar relacionadas con las enfermedades cardíacas, pero hay áreas que podrían necesitar más investigación o ajustes adicionales en el modelo. Se pueden formular hipótesis preliminares sobre las variables más influyentes, pero para una respuesta más completa al problema, se requeriría un análisis más detallado y quizás la inclusión de más variables predictoras o datos adicionales.